home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / cocktail / estra.lha / estra / src / ArgCheck.mi < prev    next >
Text File  |  1992-08-18  |  5KB  |  180 lines
  1. (* $Id: ArgCheck.mi,v 2.3 1992/08/07 15:47:31 grosch rel $ *)
  2.  
  3. IMPLEMENTATION MODULE ArgCheck;
  4.  
  5.  
  6. FROM    Character    IMPORT    Length,        Assign;
  7. FROM    Checks        IMPORT    CheckReadOpen;
  8. FROM    Errors        IMPORT    eFatal,        eRestriction,    eError,
  9.                 eWarning,    eRepair,    eNote,
  10.                 eInformation,
  11.                 eInteger,    eString,    eCharacter,
  12.                 eNoOption,    eTooManyArgs,
  13.                 tReportMode,
  14.                 ErrorMessageI,    ReportClass,    SetReportMode,
  15.                 CloseErrors;
  16. FROM    IO        IMPORT    ReadOpen;
  17. FROM    Listing        IMPORT    SourceFile;
  18. FROM    Path        IMPORT    InsertPath;
  19. FROM    Scanner        IMPORT    BeginFile;
  20. FROM    Positions    IMPORT    NoPosition;
  21. FROM    StdIO        IMPORT    WriteS, WriteNl;
  22. FROM    Strings        IMPORT    tString,    ArrayToString,    SubString,
  23.                 Concatenate,    StringToArray,    Char;
  24. FROM    SysError    IMPORT    StatIsBad,    SysErrorMessageI;
  25. FROM    System        IMPORT    GetArgCount,    GetArgument,    Exit,
  26.                 StdInput,    OpenInput;
  27. FROM    SYSTEM        IMPORT    ADR;
  28.  
  29. CONST NULL        = "/dev/null";
  30.  
  31. PROCEDURE CheckArgs;
  32.   VAR
  33.     Arg : ARRAY [0..255] OF CHAR;
  34.     ArgString : tString;
  35.     ArgNo : CARDINAL;
  36.     SourceFileIsOpen : BOOLEAN;
  37.     pos : INTEGER;
  38.     Help, HelpHelp: BOOLEAN;
  39.     Error : BOOLEAN;
  40.     Default : BOOLEAN;
  41.   BEGIN
  42.     SourceFileIsOpen := FALSE;
  43.     Help := FALSE;
  44.     HelpHelp := FALSE;
  45.     Error := FALSE;
  46.     Default := TRUE;
  47.  
  48.     FOR ArgNo:=1 TO GetArgCount () - 1 DO
  49.  
  50.       GetArgument (ArgNo, Arg);
  51.  
  52.       IF Arg [0] = '-' THEN
  53.  
  54.         (* check options *)
  55.  
  56.     Default := FALSE;
  57.  
  58.     FOR pos := 1 TO Length (Arg) - 1 DO
  59.           CASE Arg [pos] OF
  60.       | 'W': EXCL (ReportClass, eWarning);
  61.       | 'R': EXCL (ReportClass, eRepair);
  62.       | 'N': EXCL (ReportClass, eNote);
  63.       | 'I': EXCL (ReportClass, eInformation);
  64.  
  65.       | 'M': SetReportMode (eLongListing);
  66.       | 'D': SetReportMode (eDirectly);
  67.  
  68.       | 't': TEST := TRUE;
  69.  
  70.       | 'b': BU := TRUE;
  71.       | 'd': DEF := TRUE;
  72.       | 'i': IMP := TRUE;
  73.       | 'h': Help := TRUE;
  74.  
  75.       (* ARGCHECK_ *)
  76.       | '?': Help := TRUE; HelpHelp := TRUE;
  77.       | 'A': AUTO := TRUE;
  78.       | 'C': DEBUG := TRUE;
  79.       | 'G': GRAM := TRUE;
  80.       | 'T': TREE := TRUE;
  81.       | 'B': MATCH := TRUE;
  82.       (* _ARGCHECK *)
  83.  
  84.       ELSE
  85.         ErrorMessageI (eNoOption, eError, NoPosition, eCharacter, ADR (Arg [pos]));
  86.         Error := TRUE;
  87.       END;
  88.     END;
  89.  
  90.       ELSE
  91.  
  92.         (* open input file *)
  93.  
  94.         IF SourceFileIsOpen THEN
  95.       ArrayToString (Arg, ArgString);
  96.       ErrorMessageI (eTooManyArgs, eError, NoPosition, eString, ADR (ArgString));
  97.       Error := TRUE;
  98.     ELSE
  99.       SourceFile := ReadOpen (Arg);
  100.       IF StatIsBad (SourceFile) THEN
  101.         CheckReadOpen (SourceFile, Arg);
  102.       ELSE
  103.         BeginFile (Arg);
  104.         SourceFileIsOpen := TRUE;
  105.         Assign (SourceFileName, Arg);
  106.       END;
  107.     END;
  108.       END;
  109.     END;
  110.  
  111.     IF Default THEN
  112.       DEF := TRUE;
  113.       IMP := TRUE;
  114.     END;
  115.  
  116.     IF NOT SourceFileIsOpen THEN
  117.       SourceFile := ReadOpen (NULL);
  118.       CheckReadOpen (SourceFile, NULL);
  119.     END;
  120.  
  121.     IF Error THEN
  122.       CloseErrors;
  123.       Exit (1);
  124.     END;
  125.  
  126.     IF Help THEN
  127.       WriteS ('estra/'); WriteS ('cVersion'); WriteNl;
  128.       WriteS ('usage:  estra [-options] [file]'); WriteNl;
  129.       WriteNl;
  130.       WriteS ('file  specification to be compiled'); WriteNl;
  131.       WriteS ('      if no file is specified stdin is used instead'); WriteNl;
  132.       WriteNl;
  133.       WriteS ('options:'); WriteNl;
  134.       WriteS (' d    generate definition module'); WriteNl;
  135.       WriteS (' i    generate implementation module'); WriteNl;
  136.       WriteS (' b    generate bottom-up pattern matcher'); WriteNl;
  137.       WriteS (' h    print help information (this text)'); WriteNl;
  138.       WriteS (' t    print test information'); WriteNl;
  139.       WriteS (' D    report errors directly'); WriteNl;
  140.       WriteS (' M    report errors as a mixed listing'); WriteNl;
  141.       WriteS (' W    do not report warnings'); WriteNl;
  142.       WriteS (' R    do not report repairs'); WriteNl;
  143.       WriteS (' N    do not report notes'); WriteNl;
  144.       WriteS (' I    do not report informations'); WriteNl;
  145.       WriteNl;
  146.       (* ARGCHECK_ *)
  147.       IF HelpHelp THEN
  148.       WriteS (' private options for testing'); WriteNl;
  149.       WriteS (' A    test output of bottom up automaton'); WriteNl;
  150.       WriteS (' B    test output of bottom up automaton'); WriteNl;
  151.       WriteS (' C    generate code for debugging'); WriteNl;
  152.       WriteS (' G    test output of grammar'); WriteNl;
  153.       WriteS (' T    test output of tree'); WriteNl;
  154.       WriteNl;
  155.       END;
  156.       (* _ARGCHECK *)
  157.       WriteS ('the default options are -di'); WriteNl;
  158.       WriteNl;
  159.       Exit (0);
  160.     END;
  161.  
  162.   END CheckArgs;
  163.  
  164.  
  165. BEGIN
  166.   TEST := FALSE;
  167.   DEF := FALSE;
  168.   IMP := FALSE;
  169.  
  170.   SourceFileName := ' ';
  171.  
  172.   (* ARGCHECK_ *)
  173.   GRAM := FALSE;
  174.   TREE := FALSE;
  175.   MATCH := FALSE;
  176.   AUTO := FALSE;
  177.   DEBUG := FALSE;
  178.   (* _ARGCHECK *)
  179. END ArgCheck.
  180.